home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / graphics / amicad / arexx_english / draglines.amicad < prev    next >
Text File  |  1999-12-06  |  4KB  |  196 lines
  1. /* Décalage et alignement des extrémités d'un ensemble de lignes */
  2. /* Version 1.00 13/01/99 */
  3. /* Version 1.01 06/02/99, Ajout UNLOCK */
  4. /* Version 1.02 16/03/99, modif macro LIGNE */
  5. /* $VER: 1.02 (© R.Florac, 16/03/99) */
  6. options results
  7.  
  8. signal on error
  9. signal on syntax
  10.  
  11. 'DEF LIGNE(P)=P&0X07FFF'
  12. 'DEF COLONNE(P)=P>>15'
  13. 'LOCK(-1):SELECT("Bout à déplacer?"+CHR(10)+"Gauche"+CHR(10)+"Haut"+CHR(10)+"Droite"+CHR(10)+"Bas")'
  14. d=result
  15. select
  16.     when d=1 then do
  17.     'GETPOINT("Cliquez sur la colonne de destination")'; p=result
  18.     /* 'PLACEOBJ("Placez la ligne sur sa destination", FIRSTSEL, 0)'; p=result */
  19.     if p<0 then exit
  20.     'COLONNE('p')'; col=result
  21.     'SAVEALL(-1):FIRSTSEL'; o=result
  22.     do while o>0
  23.         mode=mode_ligne(o)
  24.         if mode~=-1000 then do
  25.         o = retracer_gauche(o,col,mode)
  26.         end
  27.         else do
  28.         'NEXTSEL('o')'; o=result
  29.         end
  30.     end
  31.     end
  32.     when d=2 then do
  33.     'GETPOINT("Cliquez sur la ligne de destination")'; p=result
  34.     if p<0 then exit
  35.     'LIGNE('p')'; ligne=result
  36.     'SAVEALL(-1):FIRSTSEL'; o=result
  37.     do while o>0
  38.         mode=mode_ligne(o)
  39.         if mode~=-1000 then do
  40.         o = retracer_haut(o,ligne,mode)
  41.         end
  42.         else do
  43.         'NEXTSEL('o')'; o=result
  44.         end
  45.     end
  46.     end
  47.     when d=3 then do
  48.     'GETPOINT("Cliquez sur la colonne de destination")'; p=result
  49.     if p<0 then exit
  50.     'COLONNE('p')'; col=result
  51.     'SAVEALL(-1):FIRSTSEL'; o=result
  52.     do while o>0
  53.         mode=mode_ligne(o)
  54.         if mode~=-1000 then do
  55.         o = retracer_droite(o,col,mode)
  56.         end
  57.         else do
  58.         'NEXTSEL('o')'; o=result
  59.         end
  60.     end
  61.     end
  62.     when d=4 then do
  63.     'GETPOINT("Cliquez sur la ligne de destination")'; p=result
  64.     if p<0 then exit
  65.     'LIGNE('p')'; ligne=result
  66.     'SAVEALL(-1):FIRSTSEL'; o=result
  67.     do while o>0
  68.         mode=mode_ligne(o)
  69.         if mode~=-1000 then do
  70.         o = retracer_bas(o,ligne,mode)
  71.         end
  72.         else do
  73.         'NEXTSEL('o')'; o=result
  74.         end
  75.     end
  76.     end
  77.     otherwise nop
  78. end
  79. 'UNLOCK(-1)'
  80. exit
  81.  
  82. mode_ligne: procedure
  83.     parse arg o
  84.     mode=-1000
  85.     'TYPE('o')'
  86.     select
  87.     when result=2 then mode=1   /* fil */
  88.     when result=15 then mode=2  /* ligne double */
  89.     when result=9 then mode=3   /* bus */
  90.     when result=8 then mode=0   /* pointillés */
  91.     when result=21 then do        /* ligne spéciale */
  92.         'PENWIDTH('o',-10000)'
  93.         mode=0-result
  94.     end
  95.     otherwise nop
  96.     end
  97.     return mode
  98.  
  99. minima: procedure
  100.     parse arg v1,v2
  101.     if v1<v2 then return v1
  102.     return v2
  103. end
  104.  
  105. maxima: procedure
  106.     parse arg v1,v2
  107.     if v1>v2 then return v1
  108.     return v2
  109. end
  110.  
  111. retracer_gauche: procedure
  112.     parse arg o,col,mode
  113.     'COORDS('o')'
  114.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  115.     xg=minima(x0,x1)
  116.     if x0=x1 then x1=col
  117.     if xg=x0 then do
  118.     x2=x1; y2=y1;
  119.     end
  120.     else do
  121.     x2=x0; y2=y0; y0=y1
  122.     end
  123.     'DELETE('o'):DRAWMODE('mode'):DRAW('col','y0','x2','y2')'; no=result
  124.     if no=o then o=0
  125.     else do
  126.     'NEXTSEL('o-1')'; o=result
  127.     end
  128.     return o
  129.  
  130. retracer_haut: procedure
  131.     parse arg o,ligne,mode
  132.     'COORDS('o')'
  133.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  134.     yh=minima(y0,y1)
  135.     if y0=y1 then y1=ligne
  136.     if yh=y0 then do
  137.     y2=y1; x2=x1;
  138.     end
  139.     else do
  140.     y2=y0; x2=x0; x0=x1
  141.     end
  142.     'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
  143.     if no=o then o=0
  144.     else do
  145.     'NEXTSEL('o-1')'; o=result
  146.     end
  147.     return o
  148.  
  149. retracer_droite: procedure
  150.     parse arg o,col,mode
  151.     'COORDS('o')'
  152.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  153.     xd=maxima(x0,x1)
  154.     if x0=x1 then x0=col
  155.     if xd=x1 then do
  156.     x2=x0; y2=y0; y0=y1
  157.     end
  158.     else do
  159.     x2=x1; y2=y1
  160.     end
  161.     'DELETE('o'):DRAWMODE('mode'):DRAW('x2','y2','col','y0')'; no=result
  162.     if no=o then o=0
  163.     else do
  164.     'NEXTSEL('o-1')'; o=result
  165.     end
  166.     return o
  167.  
  168. retracer_bas: procedure
  169.     parse arg o,ligne,mode
  170.     'COORDS('o')'
  171.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  172.     yb=maxima(y0,y1)
  173.     if y0=y1 then y1=ligne
  174.     if yb=y0 then do
  175.     y2=y1; x2=x1;
  176.     end
  177.     else do
  178.     y2=y0; x2=x0; x0=x1
  179.     end
  180.     'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
  181.     if no=o then o=0
  182.     else do
  183.     'NEXTSEL('o-1')'; o=result
  184.     end
  185.     return o
  186.  
  187. /* Traitement des erreurs, interruption du programme */
  188. syntax:
  189. erreur=RC
  190. 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK(-1)'
  191. exit
  192.  
  193. error:
  194. 'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK(-1)'
  195. exit
  196.